! MockBasic - version 1.8 of 5/9/86 ToolBox InitGraf(@_ThePort) ToolBox InitCursor ToolBox InitFonts ToolBox InitWindows ToolBox TEInit ToolBox InitDialogs(@@ResumeProc) ToolBox FlushEvents($FF77),NIL ! ToolBox OpenResFile("MockB.Rsrc"),NIL textType='TEXT' conditions="ÉÉÉ D, ²C,<=C,==F,=>F, ³F,<>6,><6, ­6." Poke conditions+1,ASR(Peek(conditions)-3,2) sfReply=New(74) inParam=New(80) inBuffer=New(522) outParam=New(80) outBuffer=New(522) eventRec=New(16) inLine=New(256) sym=New(256) letVar=New(256) junkStr=New(256) numStr=New(12) rect=New(8) tool=New(35) ! Set up the main output window ! ToolBox SetRect(rect,7,46,504,332) ToolBox GetNewWindow(128,NIL,-1),window ToolBox SetPort(window) ToolBox TextFont(4) ToolBox TextSize(9) Cls ! Get a handle to the ToolBox info ToolBox GetResource('TULZ',256),tulzHandle: Gosub ResErr ToolBox HLock(tulzHandle) ! Get the input file name GetInFile: goLinker=0 ! srcList & usePutFile are actually picked up in the dlgHook ! Values are being put into them now just in case srcList=1: usePutFile=1 ToolBox SFGetFile(ASL(75,16)+75,"",@@GFFileFilter,1,@textType,@@GFDlgHook,sfReply) If Peek(sfReply)=0 Then End If goLinker Then Do LPoke LPeek(LPeek($0AEC)),0 ! Clear out AppParms ToolBox GetString(256),linkerNameHandle: Gosub ResErr ToolBox HLock(linkerNameHandle): Gosub ChkErr LPoke rect,LPeek(linkerNameHandle) LPoke rect+4,0 ToolBox Launch(rect) Doend ! Set up the input & output file names fnameLen=Peek(sfReply+10) inName=New(fnameLen+1) outName=New(fnameLen+5) For i=0 To fnameLen Do Poke inName+i,Peek(sfReply+10+i) Poke outName+i,Peek(sfReply+10+i) Doend inVolume=WPeek(SFReply+6) outVolume=WPeek(SFReply+6) Poke outName,fnameLen+4 For i=1 To 4 Poke outName+fnameLen+i,Peek(".Hlx"+i) If usePutFile Then Do ToolBox SFPutFile(ASL(100,16)+85,"Select the output file:",outName,NIL,sfReply) If Peek(sfReply)=0 Then GetInFile Free outName str1=sfReply+10 outName=New(Peek(str1)+1) str2=outName Gosub CopyStr outVolume=WPeek(SFReply+6) Doend ToolBox SetPort(window) Cls Print "Input file name: ";String(inName) Print "Output file name: ";String(outName) Print ! Open the input file paramBlock=inParam: Gosub ZeroParam LPoke inParam+18,inName WPoke inParam+22,inVolume LPoke inParam+28,inBuffer Poke inParam+27,1 ToolBox Open(inParam): Gosub ChkErr ! Open the output file paramBlock=outParam: Gosub ZeroParam LPoke outParam+18,outName WPoke outParam+22,outVolume ToolBox Create(outParam) If _OSErr=0 | _OSErr=-48 Then Do LPoke outParam+28,outBuffer Poke outParam+27,2 ToolBox Open(outParam) If _OSErr=0 Then Do LPoke outParam+28,0 ToolBox SetEof(outParam) Doend Doend Gosub ChkErr WPoke inParam+44,1 LPoke inParam+46,0 ToolBox SetFPos(inParam): Gosub ChkErr WPoke inParam+44,0 ! Load in the STARTUP module Print "Loading library module:" module="STARTUP": Gosub LoadModule ! Compile it! symTab=NIL: modTab=NIL: stack=NIL: numSymbols=0 errorCount=0: eof=0: compLine=0: dataLine=0 Poke inLine,0: inPos=1 Print "Compiling..." While eof=0 Gosub Statement code="A9F4 :D": Gosub WriteCode num=dataLine: Gosub WriteNum code=" 0000": Gosub WriteCodeCrLf ! Load in the requested modules p=modTab If p­NIL Then Print "Loading library module(s):" While p­NIL Do module=p+4 Gosub LoadModule p=LPeek(p) Doend ! Close the files ToolBox Close(inParam) ToolBox Close(outParam) ! Set the output file's type to TEXT paramBlock=outParam: Gosub ZeroParam LPoke outParam+18,outName WPoke outParam+22,WPeek(SFReply+6) ToolBox GetFileInfo(outParam): Gosub ChkErr LPoke outParam+32,'TEXT' LPoke outParam+36,'MokL' ToolBox SetFileInfo(outParam): Gosub ChkErr ! Free up allocated memory list=symTab: Gosub FreeList list=modTab: Gosub FreeList If stack­NIL Then Print Chr$(7);"Compiler stack not empty!" list=stack: Gosub FreeList Free inName Free outName ! Done!!! Beep: Beep: Beep Print Print "Compile finished!" Print "Number of symbols = ";numSymbols Print "Total errors = ";errorCount Print "Press mouse button to continue..."; ToolBox FlushEvents($3F),NIL Until ret ToolBox GetNextEvent($0A,junkStr),ret Goto GetInFile LoadModule: Print " ";String(module) ToolBox GetNamedResource('STR#',module),moduleHandle: Gosub ResErr ToolBox HLock(moduleHandle) moduleBuffer=LPeek(moduleHandle)+2 num=WPeek(moduleBuffer-2) For i=1 To num Do buffer=moduleBuffer+1 bufferSize=Peek(moduleBuffer) Gosub WriteBuffer: Gosub WriteCrLf moduleBuffer=moduleBuffer+Peek(moduleBuffer)+1 Doend ToolBox HUnlock(moduleHandle) Return AddModule: p=modTab str1=module While p­NIL Do str2=p+4: Gosub EqualStr If equal Then Return p=LPeek(p) Doend p=New(Peek(module)+5): Gosub ChkErr LPoke p,modTab: modTab=p str2=p+4: Goto CopyStr !-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_ Statement: er=0: noElseFlag=0 Gosub Pause backPos=inPos Gosub GetToken While symType<0 & eof=0 Do Gosub GetLine backPos=inPos Gosub GetToken Doend If symType²0 Then Return If symType=2 Then Do inPos=backPos Goto DoLet Doend If WPeek(sym)=$013F Then DoPrint If symType<10 Then Gosub SynErr Else Do Gosub DoStatement If symType>0 & er=0 & noElseFlag=0 Then Do backPos=inPos Gosub GetToken If symType>0 & symType­103 Then Gosub SynErr If symType=23 Then inPos=backPos Doend Doend If er Then Gosub EatIt er=0 Return EatIt: backPos=inPos Gosub GetSym While symType>0 & (LPeek(sym) & $FFFFFF00)­$02444F00 Do backPos=inPos Gosub GetSym Doend If (LPeek(sym) & $FFFFFF00)=$02444F00 Then inPos=backPos Return Pause: If Inkey='.' Then If (_MODIFIERS & $100)=$100 Then Do Print "*** Compile aborted! ***": eof=1 Doend ToolBox SystemTask If Button Then BtnWait Return DoStatement: If symType=10 Then DoPrint If symType=11 Then DoLet If symType=12 Then DoGoto If symType=13 Then DoGosub If symType=14 Then DoReturn If symType=15 Then Do_End If symType=16 Then DoIf If symType=17 Then DoFor If symType=18 Then DoPStr If symType=19 Then DoCall !! If symType=20 Then DoConst If symType=21 Then DoRead If symType=22 Then DoData If symType=23 Then DoDo If symType=24 Then DoRem If symType=25 Then DoRestore If symType=26 Then DoBtnWait If symType=27 Then DoCls If symType=28 Then DoBeep If symType=29 Then DoLocate If symType=30 Then DoToolBox If symType=31 Then DoPoke If symType=32 Then DoWPoke If symType=33 Then DoLPoke If symType=34 Then DoFree If symType=35 Then DoIllegal If symType=36 Then DoWhile If symType=37 Then DoUntil If symType=38 Then DoDebug If symType=39 Then DoNop If symType=40 Then DoPasHook If symType=101 Then Do error="DOEND without DO" Goto Error Doend SynErr: error="Syntax Error" Goto Error DoPrint: module="INOUT": Gosub AddModule backPos=inPos Gosub GetToken DoPrint1: If symType²0 Then Do code="6100 >_CRLF": Goto WriteCodeCrLf Doend If symType=4 Then Do Gosub MakeStr code="6100 >_PSTR": Gosub WriteCodeCrLf Doend Else If symType=28 Then Do code="6100 >_BEEP": Gosub WriteCodeCrLf Doend !! Else If symType=102 Then DoPTab Else If symType=115 Then Do Gosub ParenEval: If er Then Return code="2040 6100 >_PSTR": Gosub WriteCodeCrLf Doend Else If symType=200 Then Do Gosub ParenEval: If er Then Return code="6100 >_PCHR": Gosub WriteCodeCrLf Doend Else Do inPos=backPos Gosub Eval: If er Then Return code="6100 >_PNUM": Gosub WriteCodeCrLf Doend backPos=inPos Gosub GetToken: If WPeek(sym)­$013B Then DoPrint1 backPos=inPos Gosub GetToken: If symType>0 Then DoPrint1 Return DoLet: Gosub GetToken If symType­2 Then SynErr str1=sym: str2=letVar: Gosub CopyStr Gosub GetToken If WPeek(sym)­$013D Then SynErr Gosub Eval: If er Then Return str1=letVar: str2=sym: Gosub CopyStr code="2B40 W": Gosub WriteCode DoVar: Gosub WriteVar: Gosub WriteCrLf MakeVar: If Peek(sym)³1 & Peek(sym+1)='_' Then Return str1=sym p=symTab While p­NIL Do str2=p+6: Gosub EqualStr: If equal Then Return p=LPeek(p) Doend numSymbols=numSymbols+1 p=New(Peek(sym)+7): Gosub ChkErr LPoke p,symTab: WPoke p+4,0 str2=p+6: Gosub CopyStr symTab=p code=" V": Gosub WriteCode Gosub WriteVar code=",4": Goto WriteCodeCrLf DoGoto: Gosub GetToken If symType­2 & symType­3 Then SynErr code="6000 >": Gosub WriteCode Gosub WriteLabel Goto WriteCrLf DoGosub: Gosub GetToken If symType­2 & symType­3 Then SynErr code="6100 >": Gosub WriteCode Gosub WriteLabel Goto WriteCrLf DoReturn: code="4E75": Goto WriteCodeCrLf Do_End: code="A9F4": Goto WriteCodeCrLf DoIf: Gosub Eval: If er Then Return Gosub GetToken: If symType­100 Then SynErr size=5: Gosub GetStack: LPoke stack+4,compLine code="4A80 ": Gosub WriteCode backPos=inPos: Gosub GetToken If symType=3 | symType=12 Then DoIfGoto If symType=2 Then Do Gosub GetSym If WPeek(sym)­$013D Then DoIfGoto Doend inPos=backPos code="6700 >C": Gosub WriteCode num=compLine: Gosub WriteNum: Gosub WriteCrLf Poke stack+8,1: compLine=compLine+2 Gosub Statement: noElseFlag=0 Goto DoElse DoIfGoto: Poke stack+8,0: compLine=compLine+1 inPos=backPos Gosub GetToken: If symType=12 Then Gosub GetToken code="6600 >": Gosub WriteCode Gosub WriteLabel: Gosub WriteCrLf DoElse: backPos=inPos Gosub GetToken While symType<0 & eof=0 Do Gosub GetLine backPos=inPos Gosub GetToken Doend If symType­103 Then Do inPos=backPos noElseFlag=1 If Peek(stack+8) Then Do code=":C": Gosub WriteCode num=LPeek(stack+4): Gosub WriteNum: Gosub WriteCrLf Doend Goto DropStack Doend If Peek(stack+8) Then Do code="6000 >C": Gosub WriteCode num=LPeek(stack+4)+1: Gosub WriteNum code=" :C": Gosub WriteCode num=LPeek(stack+4): Gosub WriteNum: Gosub WriteCrLf Doend backPos=inPos Gosub GetToken If symType=2 | symType=3 Then Do Gosub GetSym If WPeek(sym)­$013D Then Do inPos=backPos Gosub GetSym code="6000 >": Gosub WriteCode Gosub WriteLabel: Gosub WriteCrLf Goto ElseGoto Doend Doend inPos=backPos Gosub Statement ElseGoto: If Peek(stack+8) Then Do code=":C": Gosub WriteCode num=LPeek(stack+4)+1: Gosub WriteNum Gosub WriteCrLf Doend Goto DropStack DoFor: Gosub GetToken: If symType­2 Then SynErr Size=Peek(sym)+6: Gosub GetStack LPoke stack+4,compLine: Poke stack+8,0 compLine=compLine+4 str1=sym: str2=stack+9: Gosub CopyStr Gosub GetSym: If WPeek(sym)­$013D Then DropSynErr Gosub Eval: If er Then DropSynErr str1=stack+9: str2=sym: Gosub CopyStr code="2B40 W": Gosub WriteCode Gosub DoVar code=":C": Gosub WriteCode num=LPeek(stack+4): Gosub WriteNum: Gosub WriteCrLf Gosub GetToken: If symType­104 & symType­105 Then DropSynErr If symType=105 Then Poke stack+8,1 Gosub Eval: If er Then DropSynErr str1=stack+9: str2=sym: Gosub CopyStr code="B0AD W": Gosub WriteCode: Gosub WriteVar code=" 6D00 >C": If Peek(stack+8)=1 Then code=" 6E00 >C" Gosub WriteCode num=LPeek(stack+4)+1: Gosub WriteNum: Gosub WriteCrLf backPos=inPos: Gosub GetToken If symType­106 Then inPos=backPos If symType=106 Then Do code="6000 >C": Gosub WriteCode num=LPeek(stack+4)+3: Gosub WriteNum: Gosub WriteCrLf Poke stack+8,2 Gosub Eval: If er Then DropSynErr str1=stack+9: str2=sym: Gosub CopyStr code="D1AD W": Gosub WriteCode: Gosub WriteVar code=" 6000 >C": Gosub WriteCode num=LPeek(stack+4): Gosub WriteNum code=":C": Gosub WriteCode num=LPeek(stack+4)+3: Gosub WriteNum: Gosub WriteCrLf Doend Gosub Statement If Peek(stack+8)=2 Then Do code="6000 >C": Gosub WriteCode num=LPeek(stack4)+2: Gosub WriteNum: Gosub WriteCrLf Doend If Peek(stack+8)­2 Then Do str1=stack+9: str2=sym: Gosub CopyStr code="52AD W": If Peek(stack+8)=1 Then code="53AD W" Gosub WriteCode: Gosub WriteVar code=" 6000 >C": Gosub WriteCode num=LPeek(stack+4): Gosub WriteNum: Gosub WriteCrLf Doend code=":C": Gosub WriteCode num=LPeek(stack+4)+1: Gosub WriteNum: Gosub WriteCrLf Goto DropStack DoPStr: module="INOUT": Gosub AddModule Gosub Eval: If er Then Return code="2040 6100 >_PSTR": Goto WriteCodeCrLf DoCall: Gosub Eval code="2040 4E90": Goto WriteCodeCrLf DoRead: Gosub GetToken: If symType­2 Then SynErr module="READ": Gosub AddModule code="6100 >_READ 2B40 W": Gosub WriteCode Gosub DoVar Gosub GetToken: If symType²0 Then Return If WPeek(sym)­$012C Then SynErr Goto DoRead DoData: code="6000 >C": Gosub WriteCode num=compLine: Gosub WriteNum: Gosub WriteCrLf compLine=compLine+1 DoData1: Gosub GetToken While ((symType³3 & symType²6) | symType=15 | WPeek(sym)=$012D) Do code=":D": Gosub WriteCode num=dataLine: Gosub WriteNum code=" >D": Gosub WriteCode dataLine=dataLine+1 num=dataLine: Gosub WriteNum code=" ": Gosub WriteCode If symType=4 Then Do ! String code="0001 ": Gosub WriteCode hexByte=symVal: Gosub WriteHexByte code=" ": Gosub WriteCode For i=1 To symVal Do If i Mod 16=0 Then Gosub WriteCrLf hexByte=Peek(sym+i+1): Gosub WriteHexByte Doend If symVal Mod 2=0 Then Do hexByte=0: Gosub WriteHexByte Doend Doend Else If symType=15 Then Do ! END code="FFFF": Gosub WriteCode Doend Else If WPeek(sym)=$012D Then Do ! Negative number Gosub GetSym If symType­3 & symType­5 & symType­6 Then SynErr code="0000 ": Gosub WriteCode hexLong=symVal: Gosub WriteHexLong Doend Else Do ! Number code="0000 ": Gosub WriteCode hexLong=symVal: Gosub WriteHexLong Doend Gosub WriteCrLf Gosub GetSym If symType>0 Then Do If WPeek(sym)­$012C Then SynErr Gosub GetToken Doend Doend If symType>0 Then SynErr Code=":C": Gosub WriteCode num=compLine-1: Gosub WriteNum: Goto WriteCrLf DoDo: backPos=inPos Gosub GetToken If token=116 Then Return ! "Do Nothing" inPos=backPos While 1 Do backPos=inPos Gosub GetToken While symType=-1 & eof=0 Do Gosub GetLine backPos=inPos Gosub GetToken Doend If eof Then Do error="DO without DOEND" Goto Error Doend If symType=101 Then Return inPos=backPos Gosub Statement: noElseFlag=0 Doend DoRem: inPos=Peek(inLine)+1 Return DoRestore: backPos=inPos Gosub GetToken If symType=0 Then Do inPos=backPos code="6100 >_RESTORE" Goto WriteCodeCrLf Doend If symType­2 Then SynErr module="READ": Gosub AddModule code="41FA >": Gosub WriteCode Gosub WriteLabel code=" 6100 >_RESTOREL": Goto WriteCodeCrLf DoBtnWait: code="4267 A974 4A1F 67F8 4267 A974 4A1F 66F8": Goto WriteCodeCrLf DoCls: module="INOUT": Gosub AddModule code="6100 >_CLS": Goto WriteCodeCrLf DoBeep: Gosub GetSym If WPeek(sym)­$0128 Then Do ! module="INOUT": Gosub AddModule ! code="6100 >_BEEP": Goto WriteCodeCrLf code="3F3C 0008 A9C8": Goto WriteCodeCrLf Doend Gosub Eval: If er Then Return Gosub GetSym: If WPeek(sym)­$0129 Then SynErr code="3F00 A9C8": Goto WriteCodeCrLf DoLocate: module="INOUT": Gosub AddModule Gosub Eval: If er Then Return Gosub GetSym: If WPeek(sym)­$012C Then SynErr code="2F00": Gosub WriteCodeCrLf Gosub Eval: If er Then Return code="6100 >_LOCATE": Goto WriteCodeCrLf DoToolBox: Gosub GetSym: If symType­2 Then SynErr str1=sym tool=LPeek(tulzHandle) While Peek(tool) Do str2=tool: Gosub EqualStr len=Peek(tool): If (len & 1)=0 Then len=len+1 tool=tool+len+1 If equal Then DoToolBox1 tool=tool+6 Doend UnkToolBox: error="Unknown ToolBox call" Goto Error BadTool: error="Bad tool info" Goto Error DoToolBox1: toolType=LSR(Peek(tool),4) package=-1 If toolType=2 | toolType=3 Then package=Peek(tool) & $0F If toolType=0 | toolType=2 Then DoStkTool If toolType=1 | toolType=3 Then DoRegTool Goto UnkPasHook CallTool: If package=-1 Then Do hexWord=(WPeek(tool) & $0FFF)+$A000 Gosub WriteHexWord: Goto WriteCrLf Doend If Peek(tool+1)=0 Then Do code="4267 ": Gosub WriteCode Doend Else Do code="3F3C 00": Gosub WriteCode hexByte=Peek(tool+1): Gosub WriteHexByte code=" ": Gosub WriteCode Doend hexWord=$A9E7+package Gosub WriteHexWord: Goto WriteCrLf DoStkTool: parmCount=0 toolRet=Peek(tool+5) & 7 toolMask=$38 toolShift=3 If toolRet=1 | toolRet=2 Then code="558F" Else If toolRet=3 Then code="598F" Else If toolRet Then BadTool If toolRet Then Gosub WriteCodeCrLf If Peek(tool+5) & $38 Then Do Gosub GetSym: If WPeek(sym)­$0128 Then SynErr parmType=LSR(LPeek(tool+2) & toolMask,toolShift) While parmType­0 & parmCount<9 Do Gosub Eval: If er Then Return If parmType=1 Then code="1F00" Else If parmType=2 Then code="3F00" Else If parmType=3 Then code="2F00" Else BadTool Gosub WriteCodeCrLf parmCount=parmCount+1 toolMask=ASL(toolMask,3) toolShift=toolShift+3 parmType=LSR(LPeek(tool+2) & toolMask,toolShift) Gosub GetSym If parmType­0 & parmCount<9 & WPeek(sym)­$012C Then SynErr Doend If WPeek(sym)­$0129 Then SynErr Doend Gosub CallTool If toolRet=0 Then Return Gosub GetSym: If WPeek(sym)­$012C Then SynErr Gosub GetToken: If symType=208 Then Do code="548F" If toolRet=3 Then code="588F" Goto WriteCodeCrLf Doend If symType­2 Then SynErr If toolRet=1 Then code="7000 101F 2B40 W" Else If toolRet=2 Then code="301F 48C0 2B40 W" Else If toolRet=3 Then code="2B5F W" Else BadTool Gosub WriteCode Goto DoVar DoRegTool: parmCount=0 toolMask=$0003F000 toolShift=12 If (LPeek(tool+2) & toolMask)­$0001F000 Then Do Gosub GetSym: If WPeek(sym)­$0128 Then SynErr parmType=LSR(LPeek(tool+2) & toolMask,toolShift) If (LPeek(tool+2) & $3FFC0000)=$1F7C0000 Then Do Gosub Eval: If er Then Return If parmType & 15 Then Do hexWord=$2000+ASL(parmType & 7,9)+ASL(parmType & 8,3) Gosub WriteHexWord: Gosub WriteCrLf Doend Gosub GetSym Doend Else Do While parmType­$1F & parmCount<3 Do Gosub Eval: If er Then Return code="2F00": Gosub WriteCodeCrLf parmCount=parmCount+1 toolMask=ASL(toolMask,6) toolShift=toolShift+6 parmType=LSR(LPeek(tool+2) & toolMask,toolShift) Gosub GetSym If parmType­$1F & parmCount<3 & WPeek(sym)­$012C Then SynErr Doend While parmCount Do toolMask=LSR(toolMask,6) If parmCount=3 Then toolMask=$3F000000 toolShift=toolShift-6 parmCount=parmCount-1 parmType=LSR(LPeek(tool+2) & toolMask,toolShift) hexWord=$201F+ASL(parmType & 7,9)+ASL(parmType & 8,3) Gosub WriteHexWord: Gosub WriteCrLf Doend Doend If WPeek(sym)­$0129 Then SynErr Doend Gosub CallTool retReg=Peek(tool+5) & 15 toolRet=LSR(Peek(tool+5) & $30,4) Gosub RegToolRet: If er Then Return retReg=LSR(WPeek(tool+4) & $03C0,6) toolRet=LSR(WPeek(tool+4) & $0C00,10) RegToolRet: If toolRet=1 & retReg=15 Then Return If toolRet Then Do Gosub GetSym: If WPeek(sym)­$012C Then SynErr Gosub GetToken If symType=208 Then Return If symType­2 Then SynErr Doend Else Do str1="_OSERR": str2=sym: Gosub CopyStr toolRet=2 Doend If (toolRet=1 | toolRet=2) & retReg³16 Then BadTool If toolRet=1 Then Do hexWord=$0280+(retReg & 7): Gosub WriteHexWord code=" 0000 00FF ": Gosub WriteCode Doend Else If toolRet=2 Then Do hexWord=$48C0+(retReg & 7): Gosub WriteHexWord code=" ": Gosub WriteCode Doend Else If toolRet­3 Then BadTool hexWord=$2B40+retReg Gosub WriteHexWord code=" W": Gosub WriteCode Goto DoVar DoPoke: pokeStr="1080" Do_Poke: Gosub Eval: If er Then Return Gosub GetSym: If WPeek(sym)­$012C Then SynErr code="2F00": Gosub WriteCodeCrLf Gosub Eval: If er Then Return code="205F ": Gosub WriteCode code=pokeStr: Goto WriteCodeCrLf DoWPoke: pokeStr="3080": Goto Do_Poke DoLPoke: pokeStr="2080": Goto Do_Poke DoFree: Gosub Eval: If er Then Return code="2040 A01F 48C0 2B40 W_OSERR": Goto WriteCodeCrLf DoIllegal: code="4AFC": Goto WriteCodeCrLf DoWhile: code=":C": Gosub WriteCode num=compLine: Gosub WriteNum: Gosub WriteCrLf size=4: Gosub GetStack LPoke stack+4,compLine: compLine=compLine+2 Gosub Eval: If er Then dropStack code="4A80 6700 >C": Gosub WriteCode num=LPeek(stack+4)+1: Gosub WriteNum: Gosub WriteCrLf Gosub Statement code="6000 >C": Gosub WriteCode num=LPeek(Stack+4): Gosub WriteNum code=" :C": Gosub WriteCode num=LPeek(stack+4)+1: Gosub WriteNum: Gosub WriteCrLf Goto DropStack DoUntil: code="6000 >C": Gosub WriteCode num=compLine+1: Gosub WriteNum code=" :C": Gosub WriteCode num=compLine: Gosub WriteNum: Gosub WriteCrLf size=4: Gosub GetStack LPoke stack+4,compLine: compLine=compLine+3 Gosub Eval: If er Then dropStack code="4A80 6600 >C": Gosub WriteCode num=LPeek(stack+4)+2: Gosub WriteNum code=" :C": Gosub WriteCode num=LPeek(stack+4)+1: Gosub WriteNum: Gosub WriteCrLf Gosub Statement code="6000 >C": Gosub WriteCode num=LPeek(Stack+4): Gosub WriteNum code=" :C": Gosub WriteCode num=LPeek(stack+4)+2: Gosub WriteNum: Gosub WriteCrLf Goto DropStack DoDebug: Gosub GetSym If WPeek(sym)­$0128 Then code="A9FF" Else Do Gosub Eval: If er Then Return Gosub GetSym: If WPeek(sym)­$0129 Then SynErr code="2F00 ABFF" Doend Goto WriteCodeCrLf DoNop: code="4E71": Goto WriteCodeCrLf DoPasHook: Gosub GetToken: If symType­2 Then SynErr code="6000 >C": Gosub WriteCode num=compLine: Gosub WriteNum: Gosub WriteCrLf code=":": Gosub WriteCode Gosub WriteLabel: Gosub WriteCrLf Gosub GetSym: If WPeek(sym)­$013D Then SynErr Gosub GetSym: If symType­2 Then SynErr str1=sym tool=LPeek(tulzHandle) While Peek(tool) Do str2=tool: Gosub EqualStr len=Peek(tool): If (len & 1)=0 Then len=len+1 tool=tool+len+1 If equal Then DoPasHook1 tool=tool+6 Doend UnkPasHook: error="Unknown PasHook" Goto Error BadPasHook: error="Bad PasHook info" Gosub Error Goto DropStack DoPasHook1: toolType=LSR(Peek(tool),4) If toolType­4 Then UnkPasHook size=4: Gosub GetStack LPoke stack+4,compLine: compLine=compLine+1 stackSize=0 parmCount=0 toolMask=$38 toolShift=3 parmType=LSR(LPeek(tool+2) & toolMask,toolShift) While parmType­0 & parmCount<9 Do If parmType=1 | parmType=2 Then stackSize=stackSize+2 Else If parmType=3 Then stackSize=stackSize+4 Else BadPasHook toolMask=ASL(toolMask,3) toolShift=toolShift+3 parmCount=parmCount+1 parmType=LSR(LPeek(tool+2) & toolMask,toolShift) Doend If parmCount Then Do Gosub GetSym: If WPeek(sym)­$0128 Then DropSynErr toolMask=$38 toolShift=3 stackOffset=stackSize+4 While parmCount>0 Do parmType=LSR(LPeek(tool+2) & toolMask,toolShift) Gosub GetToken: If symType­2 Then DropSynErr If parmType=1 Then Do stackOffset=stackOffset-2 code="7000 102F ": Gosub WriteCode hexWord=stackOffset: Gosub WriteHexWord code=" 2B40 W": Gosub WriteCode Doend Else If parmType=2 Then Do stackOffset=stackOffset-2 code="302F ": Gosub WriteCode hexWord=stackOffset: Gosub WriteHexWord code=" 48C0 2B40 W": Gosub WriteCode Doend Else If parmType=3 Then Do stackOffset=stackOffset-4 code="2B6F ": Gosub WriteCode hexWord=stackOffset: Gosub WriteHexWord code=" W": Gosub WriteCode Doend Else BadPasHook Gosub DoVar toolMask=ASL(toolMask,3) toolShift=toolShift+3 Gosub GetSym parmCount=parmCount-1 If parmCount­0 & WPeek(sym)­$012C Then DropSynErr Doend If WPeek(sym)­$0129 Then DropSynErr Doend code="6100 >C": Gosub WriteCode num=LPeek(stack+4): Gosub WriteNum Gosub WriteCrLf toolRet=Peek(tool+5) & 7 If toolRet Then Do If toolRet>4 Then BadTool Gosub GetSym: If WPeek(sym)­$012C Then DropSynErr retSize=2 Gosub GetToken: If symType­2 Then DropSynErr If toolRet=1 Then Do Gosub DropParms code="202D W": Gosub WriteCode Gosub DoVar code="1F40 0004": Gosub WriteCodeCrLf Doend Else If toolRet=2 Then Do Gosub DropParms code="202D W": Gosub WriteCode Gosub DoVar code="3F40 0004": Gosub WriteCodeCrLf Doend Else If toolRet=3 Then Do Gosub DropParms retSize=4 code="2F6D W": Gosub WriteCode Gosub DoVar code="0004": Gosub WriteCodeCrLf Doend Else Do Gosub DropParms code="202D W": Gosub WriteCode Gosub DoVar code="0200 0001 1F40 0004": Gosub WriteCodeCrLf Doend code="4E75": Gosub WriteCodeCrLf Doend Else Do If stackSize=0 Then Do code="4E75": Gosub WriteCodeCrLf Doend Else If stackSize=4 Then Do code="2E9F 4E75": Gosub WriteCodeCrLf Doend Else If stackSize²8 Then Do code="205F ": Gosub WriteCode hexWord=$508F+ASL(stackSize,9): Gosub WriteHexWord code=" 4ED0": Gosub WriteCodeCrLf Doend Else Do code="205F DEFC ": Gosub WriteCode hexWord=stackSize: Gosub WriteHexWord code=" 4ED0": Gosub WriteCodeCrLf Doend Doend code=":C": Gosub WriteCode num=LPeek(stack+4): Gosub WriteNum Gosub WriteCrLf Goto DropStack DropParms: If stackSize=0 Then Return If stackSize=4 Then Do code="2E9F": Goto WriteCodeCrLf Doend code="2F57 ": Gosub WriteCode hexWord=stackSize: Gosub WriteHexWord: Gosub WriteCrLf If stackSize²8 Then Do hexWord=$508F+ASL(stackSize,9) Doend Else Do code="DEFC ": Gosub WriteCode hexWord=stackSize Doend Gosub WriteHexWord Goto WriteCrLf !-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_ Eval: Gosub AndOr Return ! This part handles AND and OR AndOr: Gosub Compare: If er Then Return backPos=inPos Gosub GetToken While WPeek(sym)=$0126 | WPeek(sym)=$017C | symType=112 | symType=113 Do size=2: Gosub GetStack WPoke stack+4,$C09F If WPeek(sym)=$017C | symType=113 Then WPoke stack+4,$809F code="2F00": Gosub WriteCodeCrLf Gosub Compare: If er Then DropSynErr hexWord=WPeek(stack+4): Gosub WriteHexWord Gosub WriteCrLf Gosub DropStack backPos=inPos Gosub GetToken Doend inPos=backPos Return ! This part handles comparisons Compare: Gosub AddSub: If er Then Return backPos=inPos Gosub GetToken If symType­1 Then Do inPos=backPos Return Doend If (symVal & $FF00)=0 Then symVal=symVal+$2000 For i=1 To Peek(conditions+1) If WPeek(conditions+i*4)=symVal Then IsCompare inPos=backPos Return IsCompare: branchType=Peek(conditions+i*4+2)-'0' If branchType³10 Then branchType=branchType-7 size=1: Gosub GetStack Poke stack+4,branchType code="2F00": Gosub WriteCodeCrLf Gosub Addsub: If er Then DropSynErr code="74FF B09F ": Gosub WriteCode hexByte=Peek(stack+4)+$60: Gosub WriteHexByte code="02 7400 2002": Gosub WriteCodeCrLf Gosub DropStack ! Note: expressions such as a²b²c are not allowed ! (only one comparison per customer) Return ! This part handles addition and subtraction Addsub: Gosub MultDiv: If er Then Return backPos=inPos Gosub GetToken While WPeek(sym)=$012B | WPeek(sym)=$012D Do size=1: Gosub GetStack Poke stack+4,0: If WPeek(sym)=$012D Then Poke stack+4,1 code="2F00": Gosub WriteCodeCrLf Gosub MultDiv: If er Then DropSynErr If Peek(stack+4) Then Do code="4480 ": Gosub WriteCode Doend code="D09F": Gosub WriteCodeCrLf Gosub DropStack backPos=inPos Gosub GetToken Doend inPos=backPos Return ! This part handles multiplication and division MultDiv: Gosub Factor: If er Then Return backPos=inPos Gosub GetToken While WPeek(sym)=$012A | WPeek(sym)=$012F | WPeek(sym)=$0125 | symType=110 | symType=111 Do size=1: Gosub GetStack Poke stack+4,0 If WPeek(sym)=$012F | symType=110 Then Poke stack+4,1 If WPeek(sym)=$0125 | symType=111 Then Poke stack+4,2 code="2F00": Gosub WriteCodeCrLf Gosub Factor: If er Then DropSynErr code="221F 6100 >_": Gosub WriteCode If Peek(stack+4)=0 Then code="MULT" If Peek(stack+4)=1 Then code="DIV" If Peek(stack+4)=2 Then code="MOD" Gosub WriteCodeCrLf Gosub DropStack module="MULTDIV": Gosub AddModule backPos=inPos Gosub GetToken Doend inPos=backPos Return Gosub Factor Return ! This part handles a lot of stuff Factor: Gosub GetToken If symType=0 Then Return If symType=2 Then Do code="202D W": Gosub WriteCode Goto DoVar Doend If WPeek(sym)=$012D Then DoNeg If symType=4 Then DoStringConstant If symType³3 & symType²6 Then DoConstant If WPeek(sym)=$0128 Then DoParen If WPeek(sym)=$0140 Then DoAddr If symType=201 Then DoPeek If symType=202 Then DoWPeek If symType=203 Then DoLPeek If symType=204 Then DoButton If symType=205 Then DoInkey If symType=206 Then DoAbs If symType=207 Then DoNew If symType=208 Then DoNil If symType=209 Then DoNot If symType=210 Then DoAsl If symType=211 Then DoAsr If symType=212 Then DoLsr If symType=213 Then DoSgn Goto SynErr DoStringConstant: Gosub MakeStr code="2008": Goto WriteCodeCrLf MakeStr: If symVal²125 Then Do code="41FA 0004 60" Gosub WriteCode hexByte=(symVal & $FE)+2: Gosub WriteHexByte Doend Else Do code="41FA 0006 6000 " Gosub WriteCode hexWord=(symVal & $FE)+4: Gosub WriteHexWord Doend Gosub WriteCrLf hexByte=symVal: Gosub WriteHexByte code=" ": Gosub WriteCode For i=1 To symVal Do If i Mod 16=0 Then Gosub WriteCrLf hexByte=Peek(sym+i+1): Gosub WriteHexByte Doend If symVal Mod 2=0 Then Do hexByte=0: Gosub WriteHexByte Doend Goto WriteCrLf DoNeg: backPos=inPos Gosub GetToken If symType­3 & symType­5 & symType­6 Then Do inPos=backPos Gosub Factor code="4480": Goto WriteCodeCrLf Doend symVal=-symVal DoConstant: If symVal<-128 | symVal>127 Then Do code="203C ": Gosub WriteCode hexLong=symVal: Gosub WriteHexLong Doend Else Do hexWord=$7000+(symVal & $FF): Gosub WriteHexWord Doend Goto WriteCrLf ParenEval: Gosub GetSym: If WPeek(sym)­$0128 Then SynErr DoParen: Gosub Eval Gosub GetSym: If WPeek(sym)­$0129 Then SynErr Return DoAddr: Gosub GetToken: If WPeek(sym)=$0140 Then DoLabelAddr If symType­2 Then SynErr code="41ED W": Gosub WriteCode Gosub WriteVar code=" 2008": Gosub WriteCodeCrLf Goto MakeVar DoLabelAddr: Gosub GetToken If symType­2 & symType­3 Then SynErr code="41FA >": Gosub WriteCode Gosub WriteLabel code=" 2008": Goto WriteCodeCrLf DoPeek: Gosub ParenEval code="2040 7000 1010": Goto WriteCodeCrLf DoWPeek: Gosub ParenEval code="2040 3010 48C0": Goto WriteCodeCrLf DoLPeek: Gosub ParenEval code="2040 2010": Goto WriteCodeCrLf DoInkey: module="INOUT": Gosub AddModule code="6100 >_INKEY": Goto WriteCodeCrLf DoButton: code="4267 A974 7000 4A1F 6702 70FF": Goto WriteCodeCrLf DoAbs: Gosub ParenEval code="4A80 6C02 4480": Goto WriteCodeCrLf DoNew: Gosub ParenEval code="A31E 48C0 2B40 W_OSERR 2008": Goto WriteCodeCrLf DoNil: code="7000": Goto WriteCodeCrLf DoNot: Gosub Factor code="4680": Goto WriteCodeCrLf DoAsl: sh=$0100: Goto DoShift DoAsr: sh=$0000: Goto DoShift DoLsr: sh=$0008 DoShift: Gosub GetSym: If WPeek(sym)­$0128 Then SynErr Size=2: Gosub GetStack: WPoke stack+4,sh Gosub Eval: If er Then DropSynErr Gosub GetSym: If WPeek(sym)=$0129 Then DoShiftOne If WPeek(sym)­$012C Then DropSynErr code="2F00": Gosub WriteCodeCrLf Gosub Eval: If er Then DropSynErr Gosub GetSym: If WPeek(sym)­$0129 Then DropSynErr code="2200 201F ": Gosub WriteCode hexWord=$E2A0+WPeek(stack+4): Gosub WriteHexWord: Gosub WriteCrLf Goto DropStack DoShiftOne: hexWord=$E280+WPeek(stack+4): Gosub WriteHexWord: Gosub WriteCrLf Goto DropStack DropSynErr: Gosub DropStack Goto SynErr DoSgn: Gosub ParenEval code="7402 4A80 6706 6A02 4482 2002": Gosub WriteCodeCrLf Goto SynErr !-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_ GetToken: Gosub GetSym If symType­2 Then Return Restore GetToken str1=sym NextToken: Read str2,tokenNum While _DataType­-1 Do Gosub EqualStr If equal Then Do symType=tokenNum Return Doend Read str2,tokenNum Doend Return Data "PRINT",10,"LET",11,"GOTO",12,"GOSUB",13,"RETURN",14,"END",15 Data "IF",16,"FOR",17,"PSTR",18,"CALL",19,"CONST",20,"READ",21 Data "DATA",22,"DO",23,"REM",24,"RESTORE",25,"BTNWAIT",26,"CLS",27 Data "BEEP",28,"LOCATE",29,"TOOLBOX",30,"POKE",31,"WPOKE",32,"LPOKE",33 Data "FREE",34,"ILLEGAL",35,"WHILE",36,"UNTIL",37,"DEBUG",38,"NOP",39 Data "PASHOOK",40 Data "THEN",100,"DOEND",101,"PTAB",102,"ELSE",103,"TO",104,"DOWNTO",105 Data "STEP",106,"DIV",110,"MOD",111,"AND",112,"OR",113,"XOR",114 Data "STRING",115,"NOTHING",116 Data "CHR$",200,"PEEK",201,"WPEEK",202,"LPEEK",203,"BUTTON",204 Data "INKEY",205,"ABS",206,"NEW",207,"NIL",208,"NOT",209,"ASL",210 Data "ASR",211,"LSR",212,"SGN",213 Data END,END GetSym: Poke sym,0: symVal=0: symType=0 Gosub GetCh While ch=' ' Gosub GetCh errPos=inPos If ch=0 | ch='!' Then Do if ch='!' Then inPos=inPos-1 symType=-1 Return Doend Poke sym,1: Poke sym+1,ch If ch=':' Then Return Else If chAlpha | ch='_' Then Do symType=2 Gosub GetCh While chAlpha | chNumeric | ch='_' Do Gosub AddSymCh Gosub GetCh Doend If ch='$' Then Do Gosub AddSymCh Gosub GetCh Doend inPos=lastInPos Goto UprSym Doend Else If chNumeric Then Do symType=3 symVal=ch-'0' Gosub GetCh While chNumeric Do If Peek(sym)­255 Then symVal=symVal*10+ch-'0' Gosub AddSymCh Gosub GetCh DoEnd inPos=lastInPos Return Doend Else If ch='"' Then Do symType=4 Gosub GetCh While ch­'"' & ch­0 Do If Peek(sym)­255 Then symVal=symVal+1 Gosub AddSymCh Gosub GetCh DoEnd Goto AddSymCh Doend Else If ch=$27 Then Do symType=5 Gosub GetCh While ch­$27 & ch­0 Do If Peek(sym)­255 Then symVal=ASL(symVal,8)+ch Gosub AddSymCh Gosub GetCh DoEnd Goto AddSymCh Doend Else If ch='$' Then Do symType=6 Gosub GetCh While chNumeric | (ch³'A' & ch²'F') | (ch³'a' & ch²'f') Do If Peek(sym)­255 Then Do symVal=ASL(symVal,4)+ch-'0' If ch>'9' Then symVal=symVal-7 Doend Gosub AddSymCh Gosub GetCh DoEnd inPos=lastInPos If Peek(sym)­1 Then UprSym Doend JunkSym: symType=1 symVal=ch Gosub GetCh: ch=ASL(Peek(sym+1),8)+ch If ch='<=' | ch='=<' | ch='>=' | ch='=>' | ch='<>' | ch='><' Then Do Poke sym,2: Poke sym+2,ch: symVal=ch Return Doend inPos=lastInPos Return UprSym: ToolBox UprString(sym+1,Peek(sym)) Return AddSymCh: If Peek(sym)=255 Then Return Poke sym,Peek(sym)+1 Poke sym+Peek(sym),ch Return GetCh: lastInPos=inPos: chAlpha=0: chNumeric=0 If inPos=0 | inPos>Peek(inLine) Then ch=0 Else Do ch=Peek(inLine+inPos) inPos=inPos+1 If ch<32 Then ch=32 chAlpha=(ch³'A' & ch²'Z') | (ch³'a' & ch²'z') chNumeric=(ch³'0' & ch²'9') Doend Return EqualStr: ToolBox CmpString(str1+1,str2+1,ASL(Peek(str1),16)+Peek(str2)),equal equal=1-equal Return CopyStr: For i=0 to Peek(str1) Poke str2+i,Peek(str1+i) Return Error: er=1 Beep Print String(error);":" Print String(inLine) For i=3 To errPos Print " "; Print "^" errorCount=errorCount+1 Return ZeroParam: For i=0 To 79 Poke paramBlock+i,0 Return GetStack: p=New(size+4): Gosub ChkErr LPoke p,stack stack=p Return DropStack: p=LPeek(stack) Free stack: Gosub ChkErr stack=p Return FreeList: While list­NIL Do p=list list=LPeek(list) Free p Doend Return GetLine: Gosub ReadLine backPos=inPos Gosub GetToken While symType<0 & eof=0 Do Gosub Pause Gosub ReadLine backPos=inPos Gosub GetToken Doend NotLabel: If symType<2 | symType>3 Then Do inPos=backPos Return Doend If symType=3 Then DoLabel str1=sym: str2=junkStr Gosub CopyStr Gosub GetSym If symType­0 Then NotLabel str1=junkStr: str2=sym Gosub CopyStr DoLabel: code=":" Gosub WriteCode Gosub WriteLabel Goto WriteCrlf WriteLabel: code="L" Goto WriteVarLabel WriteVar: code="V" WriteVarLabel: If Peek(sym)³1 & Peek(sym+1)­'_' Then Gosub WriteCode str=sym Goto WriteStr ReadLine: inPos=1 errPos=0 Poke inLine,0 If eof Then Return buffer=inLine+1: bufferSize=255: newLine=13 Gosub ReadBuffer lineLength=LPeek(inParam+40) If _OSErr=-39 & lineLength=0 Then eof=-1 If Peek(inLine+lineLength)=13 Then lineLength=lineLength-1 Poke inLine,lineLength If lineLength=255 Then Do Gosub ReadCh If ch­13 Then Do Print Chr$(7);"Warning: Next line >255 characters, truncated" If srcList=0 Then Print String(inLine) errorCount=errorCount+1 While ch­13 & _OSErr=0 Gosub ReadCh Doend Doend If srcList & eof=0 Then Print String(inLine) Return ReadCh: ch=0 buffer=@ch+3: bufferSize=1: newLine=0 ReadBuffer: LPoke inParam+32,buffer LPoke inParam+36,bufferSize WPoke inParam+44,0 If newLine Then Do WPoke inParam+44,ASL(newLine,8)+$80 Doend ToolBox Read(inParam) If _OSErr=-39 | _OSErr=0 Then Return Goto ChkErr WriteNum: ToolBox NumToString(num,numStr) str=numStr Goto WriteStr WriteCode: str=code WriteStr: buffer=str+1 bufferSize=Peek(str) Goto WriteBuffer WriteHexLong: hexWord=LSR(hexLong,16): Gosub WriteHexWord hexWord=hexLong & $FFFF WriteHexWord: hexByte=LSR(hexWord,8): Gosub WriteHexByte hexByte=hexWord & $FF WriteHexByte: byte=LSR(hexByte,4): Gosub WriteHexChar byte=hexByte WriteHexChar: byte=byte & $0F If byte³10 Then byte=byte+7 byte=byte+'0' Goto WriteByte WriteCodeCrlf: Gosub WriteCode WriteCrLf: byte=13 WriteByte: buffer=@byte+3 bufferSize=1 WriteBuffer: LPoke outParam+32,buffer LPoke outParam+36,bufferSize ToolBox Write(outParam) Goto ChkErr ResumeProc: _OSErr=99 Goto ChkErr ResErr: ToolBox ResError,_OSErr ChkErr: If _OSErr=0 Then Return temp=_OSErr ToolBox Close(inParam) ToolBox Close(outParam) _OSErr=temp Print Print "OS error code #";_OSErr If _OSErr=-33 | _OSErr=-34 Then Print "Disk full!" If _OSErr=-36 Then Print "I/O error!" If _OSErr=-49 | _OSErr=-47 Then Print "File already open!" If _OSErr=-108 Then Print "Out of memory!" Print "Press mouse button to return to the Finder." BtnWait End ! File filter procedure for SFGetFile PasHook GFFileFilter=MyFileFilter(paramBlock),ret ret=0 fName=LPeek(paramBlock+18) If Peek(fName)<4 Then Return For i=0 To 3 Poke @hlxType+i,Peek(fName+Peek(fName)+i-3) ToolBox UprString(@hlxType,4) If hlxType='.HLX' Then ret=1 Return PasHook GFDlgHook=MyDlg(dlgItem,theDialog),dlgItem ! Note: This is not documented in Inside Macintosh, but the Standard ! File package (but not the Dialog Manager) sends an item number ! of -1 to the dlgHook procedure before the dialog window is ! made visible. If dlgItem=-1 Then Do ! Get initial value of 'srcList' & 'usePutFile' ToolBox GetDItem(theDialog,12,rect,@dItemHandle,rect) ToolBox GetCtlValue(dItemHandle),usePutFile ToolBox GetDItem(theDialog,14,rect,@dItemHandle,rect) ToolBox GetCtlValue(dItemHandle),srcList ! Check for linker ToolBox GetString(256),linkerNameHandle: Gosub ResErr ToolBox HLock(linkerNameHandle): Gosub ChkErr ToolBox OpenResFile(LPeek(linkerNameHandle)),ret If ret=-1 Then Do ToolBox GetDItem(theDialog,11,rect,@dItemHandle,rect) ToolBox HiliteControl(dItemHandle,255) Doend Else ToolBox CloseResFile(ret) ToolBox HUnlock(linkerNameHandle) Doend Else If dlgItem=11 Then Do ! Click on 'Linker' button goLinker=-1 dlgItem=1 Doend Else If dlgItem=12 Then Do ! Click on 'usePutFile' control usePutFile=1-usePutFile ToolBox GetDItem(theDialog,dlgItem,rect,@dItemHandle,rect) ToolBox SetCtlValue(dItemHandle,usePutFile) Doend Else If dlgItem=14 Then Do ! Click on 'srcList' control srcList=1-srcList ToolBox GetDItem(theDialog,dlgItem,rect,@dItemHandle,rect) ToolBox SetCtlValue(dItemHandle,srcList) Doend Return